home *** CD-ROM | disk | FTP | other *** search
/ Hardcore Visual Basic 5.0 (2nd Edition) / Hardcore Visual Basic 5.0 - Second Edition (1997)(Microsoft Press).iso / Code / Goodies / CallBack / FONTENUM.CLS < prev    next >
Text File  |  1997-06-09  |  1KB  |  38 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "FontEnumerator"
  6. Attribute VB_GlobalNameSpace = False
  7. Attribute VB_Creatable = False
  8. Attribute VB_PredeclaredId = False
  9. Attribute VB_Exposed = False
  10. Option Explicit
  11.  
  12. Private m_CallBack As CallBack
  13. Private NTM As NEWTEXTMETRIC
  14. Private NLF As LOGFONT
  15.  
  16. #If False Then
  17. Function EnumFontFamProc(ByVal lpNLF As Long, ByVal lpNTM As Long, ByVal FontType As Long, LParam As ListBox) As Long
  18. #Else
  19. Function EnumFontFamProc(ByVal lpNLF As Long, ByVal lpNTM As Long, ByVal FontType As Integer, LParam As ListBox) As Integer
  20. #End If
  21. Dim FaceName As String
  22.     CopyMemory NLF, ByVal lpNLF, Len(NLF)
  23.     CopyMemory NTM, ByVal lpNTM, Len(NTM)
  24.     FaceName = String$(LF_FACESIZE, 0)
  25.     CopyMemory ByVal FaceName, NLF.lfFaceName(0), LF_FACESIZE + 1
  26.     LParam.AddItem Left$(FaceName, InStr(FaceName, vbNullChar) - 1)
  27.     EnumFontFamProc = 1
  28. End Function
  29.  
  30. Private Sub Class_Initialize()
  31.     Set m_CallBack = NewCallBack(CBType_FONTENUMPROC, Me, True)
  32. End Sub
  33.  
  34. Public Property Get ProcAddress() As Long
  35.     ProcAddress = m_CallBack.ProcAddress
  36. End Property
  37.  
  38.